home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s5.arc / SENDMDM7.MOD < prev    next >
Text File  |  1987-04-25  |  15KB  |  403 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Send_Modem7_File --- Upload file with Modem7/Telink           *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Send_Modem7_File( Use_CRC: BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Send_Modem7_File                                     *)
  10. (*                                                                      *)
  11. (*     Purpose:    Uploads file using Modem7/Telink batch               *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Send_Modem7_File( Use_CRC: BOOLEAN);                          *)
  16. (*                                                                      *)
  17. (*           Use_CRC --- TRUE to use CRC checking;                      *)
  18. (*                       FALSE to use Checksum checking.                *)
  19. (*                                                                      *)
  20. (*     Calls:   KeyPressed                                              *)
  21. (*              Async_Send                                              *)
  22. (*              Async_Receive_With_TimeOut                              *)
  23. (*              Get_Modem7_File_Name                                    *)
  24. (*              Check_KeyBoard                                          *)
  25. (*              RvsVideoOn                                              *)
  26. (*              RvsVideoOff                                             *)
  27. (*              Wait_For_Nak                                            *)
  28. (*              Send_File_Name                                          *)
  29. (*              Perform_Upload                                          *)
  30. (*                                                                      *)
  31. (*      Remarks:                                                        *)
  32. (*                                                                      *)
  33. (*         This routine performs wildcard directory searches and        *)
  34. (*         implements the Modem7 and Telink batch file transfer         *)
  35. (*         protocols.                                                   *)
  36. (*                                                                      *)
  37. (*----------------------------------------------------------------------*)
  38.  
  39. VAR
  40.    File_Pattern : AnyStr;
  41.    SFileName    : PACKED ARRAY[1..11] OF CHAR;
  42.    Int_Ch       : INTEGER;
  43.    Ch           : CHAR;
  44.    CheckSum     : INTEGER;
  45.    EndFName     : BOOLEAN;
  46.    I            : INTEGER;
  47.    J            : INTEGER;
  48.    File_Entry   : Directory_Record;
  49.    Ack_OK       : BOOLEAN;
  50.    OK_File      : BOOLEAN;
  51.  
  52. (*----------------------------------------------------------------------*)
  53. (*    Extract_Upload_Path_Name --- Extract the upload path name         *)
  54. (*----------------------------------------------------------------------*)
  55.  
  56. PROCEDURE Extract_Upload_Path_Name;
  57.  
  58. VAR
  59.    I   : INTEGER;
  60.    Done: BOOLEAN;
  61.  
  62. BEGIN (* Extract_Upload_Path_Name *)
  63.  
  64.    I    := LENGTH( File_Pattern ) + 1;
  65.    Done := FALSE;
  66.  
  67.    WHILE ( NOT Done ) DO
  68.       BEGIN
  69.          I    := I - 1;
  70.          Done := ( File_Pattern[I] = ':' ) OR
  71.                  ( File_Pattern[I] = '\' ) OR
  72.                  ( I = 1 );
  73.       END;
  74.  
  75.    IF ( I > 1 ) THEN
  76.       Upload_Dir_Path := COPY( File_Pattern, 1, I )
  77.    ELSE
  78.       Upload_Dir_Path := '';
  79.  
  80.    IF ( POS( '\', Upload_Dir_Path ) <> 0 ) THEN
  81.       IF ( Upload_Dir_Path[LENGTH( Upload_Dir_Path )] <> '\' ) THEN
  82.          Upload_Dir_Path := Upload_Dir_Path + '\';
  83.  
  84. END   (* Extract_Upload_Path_Name *);
  85.  
  86. (*----------------------------------------------------------------------*)
  87. (*              Check_KeyBoard --- Check for keyboard input             *)
  88. (*----------------------------------------------------------------------*)
  89.  
  90. PROCEDURE Check_KeyBoard;
  91.  
  92. BEGIN (* Check_KeyBoard *)
  93.                                    (* If Alt_R found, stop transfer *)
  94.    WHILE KeyPressed DO
  95.       BEGIN
  96.  
  97.          READ( Kbd, Ch );
  98.  
  99.          IF ( Ch = CHR( ESC ) ) AND KeyPressed THEN
  100.             BEGIN
  101.                READ( Kbd, Ch );
  102.                IF ORD( Ch ) = Alt_S THEN
  103.                   BEGIN
  104.                      Stop_Send := TRUE;
  105.                      WRITELN('  Alt_S accepted, transfer cancelled.');
  106.                   END
  107.                ELSE
  108.                   Handle_Function_Key( Ch );
  109.             END;
  110.  
  111.       END;
  112.  
  113. END   (* Check_KeyBoard *);
  114.  
  115. (*----------------------------------------------------------------------*)
  116. (*       Get_Modem7_File_Name --- Construct file name to MODEM7 form    *)
  117. (*----------------------------------------------------------------------*)
  118.  
  119. PROCEDURE Get_Modem7_File_Name( VAR OK_File : BOOLEAN );
  120.  
  121. (*----------------------------------------------------------------------*)
  122. (*                                                                      *)
  123. (*     Remarks:                                                         *)
  124. (*                                                                      *)
  125. (*        The filename for Modem7 is 11 characters long.  The filename  *)
  126. (*        is left-justified and blank-filled in the first 8 characters. *)
  127. (*        The extension appears left-justified and blank-filled in      *)
  128. (*        positions 9 through 11.                                       *)
  129. (*                                                                      *)
  130. (*        Examples:                                                     *)
  131. (*                                 12345678901                          *)
  132. (*           'root.dat'  becomes:  root    dat                          *)
  133. (*           'root'      becomes:  root                                 *)
  134. (*                                                                      *)
  135. (*        Note that the checksum INCLUDES the terminating Ctrl-z (SUB)  *)
  136. (*        character of the file name.                                   *)
  137. (*                                                                      *)
  138. (*        In host mode, a check is made to ensure that the file to be   *)
  139. (*        sent is on the transfer list.  If not, it is not sent.        *)
  140. (*                                                                      *)
  141. (*----------------------------------------------------------------------*)
  142.  
  143. BEGIN (* Get_Modem7_File_Name *)
  144.  
  145.    I             := 1;
  146.    J             := 0;
  147.    SFileName     := '           ';
  148.    FileName      := '';
  149.  
  150.    WHILE( File_Entry.File_Name[I] <> CHR( 0 ) ) AND ( I <= 12 ) DO
  151.       BEGIN
  152.  
  153.          Ch := File_Entry.File_Name[I];
  154.  
  155.          IF Ch = '.' THEN
  156.             J := 8
  157.          ELSE
  158.             BEGIN
  159.                J            := J + 1;
  160.                SFileName[J] := Ch;
  161.             END;
  162.  
  163.          FileName := FileName + Ch;
  164.  
  165.          I  := I + 1;
  166.  
  167.       END;
  168.                                    (* Get checksum *)
  169.    CheckSum := 0;
  170.  
  171.    FOR I := 1 TO 11 DO
  172.       CheckSum := ( CheckSum + ORD( SFileName[I] ) ) AND 255;
  173.  
  174.    CheckSum := ( CheckSum + SUB ) AND 255;
  175.  
  176.    OK_File := ( File_Entry.File_Attr AND
  177.                 ( Dir_Attr_Volume_Label + Dir_Attr_Subdirectory ) = 0 );
  178.  
  179.                                    (* If host mode, make sure file *)
  180.                                    (* is on xferlist!              *)
  181.    IF Host_Mode THEN
  182.       IF ( Privilege <> 'S' ) THEN
  183.          OK_File := OK_File AND ( Scan_Xfer_List( FileName ) > 0 );
  184.  
  185. END   (* Get_Modem7_File_Name *);
  186.  
  187. (*----------------------------------------------------------------------*)
  188. (*             Wait_For_Nak --- Wait for NAK at start of file name      *)
  189. (*----------------------------------------------------------------------*)
  190.  
  191. PROCEDURE Wait_For_Nak;
  192.  
  193. BEGIN (* Wait_For_Nak *)
  194.  
  195.    I := 0;
  196.                                    (* Wait up to minute for NAK *)
  197.    REPEAT
  198.       Async_Receive_With_Timeout( One_Second , Int_Ch );
  199.       Check_KeyBoard;
  200.       I := I + 1;
  201.    UNTIL ( Int_Ch  = NAK ) OR
  202.          ( I      >= 60  ) OR
  203.          Stop_Send;
  204.  
  205.    IF ( Int_Ch <> NAK ) THEN
  206.       BEGIN
  207.          Stop_Send := TRUE;
  208.          WRITELN('   NAK for start of file name not received;');
  209.          WRITELN('   Received Ascii ',Int_Ch,' instead.');
  210.       END
  211.    ELSE                            (* If NAK found, ACK it *)
  212.       BEGIN
  213.          Async_Send( CHR( ACK ) );
  214.       END;
  215.                                    (* Wait for com line to clear *)
  216.    Async_Purge_Buffer;
  217.  
  218. END   (* Wait_For_Nak *);
  219.  
  220. (*----------------------------------------------------------------------*)
  221. (*             Send_File_Name --- Send file name characters             *)
  222. (*----------------------------------------------------------------------*)
  223.  
  224. PROCEDURE Send_File_Name;
  225.  
  226. (*----------------------------------------------------------------------*)
  227. (*                                                                      *)
  228. (*     Remarks:                                                         *)
  229. (*                                                                      *)
  230. (*        The file name characters are sent one at a time.  After       *)
  231. (*        each is sent, we wait for an ACK.  To end the file name       *)
  232. (*        we send an SUB (ctrl-z) character.                            *)
  233. (*                                                                      *)
  234. (*----------------------------------------------------------------------*)
  235.  
  236. VAR
  237.    I: INTEGER;
  238.    J: INTEGER;
  239.  
  240. BEGIN (* Send_File_Name *)
  241.  
  242.    I := 0;
  243.  
  244.    WHILE( NOT Stop_Send ) AND ( I < 11 ) DO
  245.       BEGIN
  246.  
  247.          I := I + 1;
  248.  
  249.          Async_Send( SFileName[I] );
  250.  
  251.          J := 0;
  252.  
  253.          REPEAT
  254.             Async_Receive_With_Timeout( One_Second , Int_Ch );
  255.             Check_KeyBoard;
  256.             J := J + 1;
  257.          UNTIL ( Int_Ch  = ACK ) OR
  258.                ( J      >= 10  );
  259.  
  260.          Ack_OK := ( Int_Ch = ACK );
  261.  
  262.          Stop_Send := Stop_Send OR ( NOT Ack_OK );
  263.  
  264.       END;
  265.                                    (* Send End of file name character *)
  266.                                    (* and await receiver to send      *)
  267.                                    (* checksum.                       *)
  268.    IF NOT Stop_Send THEN
  269.       BEGIN
  270.  
  271.          Async_Send( CHR( SUB ) );
  272.  
  273.          J := 0;
  274.  
  275.          REPEAT
  276.             Async_Receive_With_Timeout( One_Second , Int_Ch );
  277.             Check_KeyBoard;
  278.             J := J + 1;
  279.          UNTIL ( Int_Ch  = CheckSum ) OR
  280.                ( J      >= 10  );
  281.  
  282.          IF ( Int_Ch <> CheckSum ) THEN
  283.             BEGIN
  284.                Stop_Send := TRUE;
  285.                WRITELN('   Received checksum for filename not correct;');
  286.                WRITELN('   Correct checksum = ',CheckSum,', received ',Int_Ch);
  287.             END
  288.          ELSE
  289.             Async_Send( CHR( ACK ) );
  290.  
  291.       END;
  292.  
  293. END   (* Send_File_Name *);
  294.  
  295. (*----------------------------------------------------------------------*)
  296. (*                Perform_Upload --- Do the upload                      *)
  297. (*----------------------------------------------------------------------*)
  298.  
  299. PROCEDURE Perform_Upload;
  300.  
  301. BEGIN (* Perform_Upload *)
  302.  
  303.    IF Display_Status THEN
  304.       WRITELN('  Uploading: ' + FileName );
  305.    Write_Log('Uploading: ' + FileName , FALSE, FALSE );
  306.  
  307.    IF Transfer_Protocol = Telink THEN
  308.       Make_Telink_Header( File_Entry );
  309.  
  310.    IF ( NOT Stop_Send ) THEN
  311.       Send_Xmodem_File( Use_CRC );
  312.  
  313.    TextColor( Menu_Text_Color );
  314.    TextBackGround( BLACK );
  315.  
  316. END   (* Perform_Upload *);
  317.  
  318. (*----------------------------------------------------------------------*)
  319.  
  320. BEGIN (* Send_Modem7_File *)
  321.                                    (* Open batch transfer window    *)
  322.    Display_Batch_Window;
  323.                                    (* CRC except Modem7 Checksum *)
  324.  
  325.    Use_CRC     := Use_CRC AND ( Transfer_Protocol <> Modem7_Chk );
  326.  
  327.                                    (* Get file name pattern to send *)
  328.    File_Pattern  := FileName;
  329.                                    (* Pick up drive and path name    *)
  330.    IF ( NOT Host_Mode ) THEN
  331.       Extract_Upload_Path_Name;
  332.                                    (* See if we can find anything to *)
  333.                                    (* be sent.                       *)
  334.  
  335.    Stop_Send    := ( Dir_Find_First_File( File_Pattern, File_Entry ) <> 0 );
  336.  
  337.    IF Stop_Send THEN
  338.       WRITELN('  No files found to send.');
  339.  
  340.                                    (* Loop over file names         *)
  341.    WHILE( NOT Stop_Send ) DO
  342.       BEGIN
  343.                                    (* Get file name *)
  344.  
  345.          Get_Modem7_File_Name( OK_File );
  346.  
  347.                                    (* If file can be sent, do it   *)
  348.          IF OK_File THEN
  349.             BEGIN
  350.                                    (* Wait for NAK indicating host *)
  351.                                    (* is ready for the file name.  *)
  352.                IF NOT Stop_Send THEN
  353.                   Wait_For_Nak;
  354.                                    (* Send file name characters     *)
  355.                IF NOT Stop_Send THEN
  356.                   Send_File_Name;
  357.                                    (* Send the file itself          *)
  358.                IF NOT Stop_Send THEN
  359.                   Perform_Upload;
  360.  
  361.             END;
  362.                                    (* See if more files to transfer *)
  363.  
  364.          Stop_Send := Stop_Send OR ( Dir_Find_Next_File( File_Entry ) <> 0 );
  365.  
  366.       END (* While *);
  367.                                    (* Send EOT to indicate no more files *)
  368.    Async_Send( CHR( EOT ) );
  369.                                    (* Wait for ACK                       *)
  370.  
  371.    Async_Receive_With_TimeOut( Five_Seconds , Int_Ch );
  372.  
  373.    TextColor( Menu_Text_Color );
  374.    TextBackGround( BLACK );
  375.  
  376.    IF ( NOT Display_Status ) THEN
  377.       Display_Batch_Window;
  378.  
  379.    IF ( Int_Ch = ACK ) THEN
  380.       BEGIN
  381.          WRITELN(' ');
  382.          WRITELN('  Host system ACKnowledged EOT.');
  383.          Write_Log('  Host system ACKnowledged EOT.', FALSE, FALSE);
  384.       END;
  385.                                    (* Indicate end of transfer    *)
  386.  
  387.    WRITELN(' ');
  388.  
  389.    RvsVideoOn ( Menu_Text_Color, BLACK );
  390.  
  391.    WRITELN('  Batch transfer complete.');
  392.    Write_Log('Batch transfer complete.' , FALSE, FALSE );
  393.  
  394.    RvsVideoOff( Menu_Text_Color, BLACK );
  395.  
  396.    DELAY( Two_Second_Delay );
  397.                                    (* Remove batch transfer window *)
  398.    Restore_Screen( Batch_Screen_Ptr );
  399.  
  400.    Reset_Global_Colors;
  401.  
  402. END   (* Send_Modem7_File *);
  403.